Covid analysis about the situation in Finland
Jouni Tuomisto
2021-04-06
Download data
First we download data from THL open data repository.
# https://thl.fi/fi/tilastot-ja-data/aineistot-ja-palvelut/avoin-data/varmistetut-koronatapaukset-suomessa-covid-19-
dat <- read.csv("data/covid_statistics_history.csv") # Historical, mostly weekly data until 2021-02-15
dat$period <- ifelse(grepl("Vuosi",dat$date), "weekly","daily")
dat <- dat[!is.na(dat$value),]
dat2 <- read.csv("http://77.86.191.32/rtools_server/runs/covid_statistics_daily_fi.csv") #daily updates
dat2$period <- "cumulative"
dat <- rbind(dat, dat2)
colnames(dat)[1:3] <- c("place","age","date")
for(i in c("place","age","date","sex","measure")) {
dat[[i]] <- as.factor(dat[[i]])
}
start <- as.POSIXct("2019-12-29 12:00 EET")
shp <- as.character(unique(dat$place[grep("(SHP|Ahvenanmaa)",dat$place)]))
dat$time <- (start + (as.numeric(substr(dat$date,10,10)) * 53 + as.numeric(substr(dat$date,19,20))) * 7*24*3600)
dat$time[dat$period!="weekly"] <- as.POSIXct(paste0(dat$date[dat$period!="weekly"], " 12:00 EET"))
dat$value[dat$value==".."] <- "-1"
dat$value <- as.integer(dat$value)
# Find the highest weekly case value for each place. Note: for only ca. 10 places the peak occurs before August 2020.
tmp <- dat[dat$period=="weekly" & dat$measure=="cases",] %>%
mutate(value=as.integer(value)) %>%
group_by(place) %>%
filter(value == max(value,na.rm=TRUE))
tmp <- tmp[!duplicated(tmp$place),c("place","time")]
colnames(tmp)[2] <- "peak"
dat <- merge(dat, tmp, all.x=TRUE)
dat$peak <- dat$time - dat$peak
#####################
# This code should be updated. It contains the location hierarchy.
if(FALSE) {
rl <- readLines("https://sampo.thl.fi/pivot/prod/fi/epirapo/covid19case/fact_epirapo_covid19case.dimensions.json")
rl[1] <- "{"
rl[2] <- '"test":['
rl[length(rl)] <- "}"
rl <- jsonlite::fromJSON(rl)
tst <- unlist(rl, recursive=FALSE)
} # ENDIF
############################3Data analysis and plots
What is the timeline of cases? What is the timeline relative to the peak value in each place?
tmp <- dat[dat$measure == "cases" & grepl("SHP",dat$place) & dat$period=="weekly" , ]
tmp <- tmp[order(tmp$peak),]
# Plot health care district cases along the timeline
plot_ly(data = tmp, x=~time, y=~value, type="scatter", mode="lines", fillcolor=~place) %>%
layout(title="Weekly cases by health care district")## Warning: `arrange_()` was deprecated in dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help# Plot health care district cases relative to the peak event
plot_ly(data = tmp, x=~peak, y=~as.numeric(value), type="scatter", mode="lines", fillcolor=~place) %>%
layout(title="Weekly cases by health care district relative to the peak")tmp <- dat[dat$measure=="cases" & !grepl("SHP",dat$place) & dat$period=="weekly",]
tmp <- tmp[order(tmp$peak),]
# Plot municipality cases relative to the peak event
plot_ly(data = tmp, x=~peak, y=~value, type="scatter", mode="lines", fillcolor=~place) %>%
layout(title="Weekly cases by municipality relative to the peak")# See how many-fold the decrease is 2 weeks after the peak
tmp <- tmp[!is.na(tmp$peak) & (tmp$peak == 0 | tmp$peak == 14*24*3600) , ]
tmp$value[tmp$peak!=0] <- 1 / tmp$value[tmp$peak!=0]
tmp <- aggregate(tmp["value"], by = tmp[c("place","measure","period")], FUN = prod)
cat("See how many-fold the decrease is 2 weeks after the largest peak in each place\n
If a place is not in the list, both values are below the detection limit.\n
Negative values mean that the peak had that number of cases and then decreased to below the detection limit.\n
Vantaa is an artifact because the peak is 2021-02-14 and therefore the second value is missing.\n")## See how many-fold the decrease is 2 weeks after the largest peak in each place
##
## If a place is not in the list, both values are below the detection limit.
##
## Negative values mean that the peak had that number of cases and then decreased to below the detection limit.
##
## Vantaa is an artifact because the peak is 2021-02-14 and therefore the second value is missing.tmp[tmp$value!=1,]## place measure period value
## 1 Ahvenanmaa cases weekly 3.375000
## 3 Alajärvi cases weekly 6.857143
## 7 Askola cases weekly -8.000000
## 8 Aura cases weekly -6.000000
## 9 Brändö cases weekly -12.000000
## 13 Espoo cases weekly 1.211321
## 22 Haapavesi cases weekly -6.000000
## 25 Hamina cases weekly -11.000000
## 27 Hankasalmi cases weekly -8.000000
## 31 Hattula cases weekly 1.666667
## 32 Hausjärvi cases weekly -5.000000
## 33 Heinola cases weekly -9.000000
## 35 Helsinki cases weekly 1.040142
## 37 Hollola cases weekly 1.181818
## 38 Honkajoki cases weekly -18.000000
## 42 Hyvinkää cases weekly 1.437500
## 43 Hämeenkyrö cases weekly -8.000000
## 44 Hämeenlinna cases weekly 3.750000
## 45 Ii cases weekly -5.000000
## 46 Iisalmi cases weekly -7.000000
## 48 Ikaalinen cases weekly -6.000000
## 50 Ilomantsi cases weekly -12.000000
## 51 Imatra cases weekly 2.875000
## 57 Joensuu cases weekly 4.230769
## 64 Juva cases weekly -5.000000
## 65 Jyväskylä cases weekly 4.363636
## 67 Jämsä cases weekly -9.000000
## 68 Järvenpää cases weekly 73.000000
## 69 Kaarina cases weekly 3.090909
## 71 Kaikki Alueet cases weekly 1.079174
## 72 Kajaani cases weekly -15.000000
## 73 Kalajoki cases weekly -9.000000
## 74 Kangasala cases weekly 2.200000
## 75 Kangasniemi cases weekly -15.000000
## 76 Kankaanpää cases weekly -5.000000
## 78 Kannus cases weekly -5.000000
## 80 Karkkila cases weekly 2.500000
## 82 Karvia cases weekly -27.000000
## 84 Kauhajoki cases weekly -9.000000
## 85 Kauhava cases weekly -5.000000
## 86 Kauniainen cases weekly -9.000000
## 87 Kaustinen cases weekly -6.000000
## 89 Kemi cases weekly 2.600000
## 92 Kemiönsaari cases weekly -7.000000
## 93 Kempele cases weekly -14.000000
## 94 Kerava cases weekly -36.000000
## 98 Kirkkonummi cases weekly 1.111111
## 99 Kitee cases weekly -22.000000
## 100 Kittilä cases weekly -16.000000
## 101 Kiuruvesi cases weekly -14.000000
## 104 Kokkola cases weekly -5.000000
## 105 Kolari cases weekly -10.000000
## 108 Korsnäs cases weekly -9.000000
## 110 Kotka cases weekly 5.166667
## 111 Kouvola cases weekly 2.933333
## 112 Kristiinankaupunki cases weekly -8.000000
## 113 Kruunupyy cases weekly -10.000000
## 114 Kuhmo cases weekly -13.000000
## 117 Kuopio cases weekly 5.000000
## 119 Kurikka cases weekly -7.000000
## 122 Kyyjärvi cases weekly -6.000000
## 126 Lahti cases weekly 4.794872
## 128 Laitila cases weekly -19.000000
## 129 Lapinjärvi cases weekly -7.000000
## 132 Lappeenranta cases weekly 2.125000
## 133 Lapua cases weekly -5.000000
## 134 Laukaa cases weekly -9.000000
## 137 Lempäälä cases weekly 3.083333
## 139 Lestijärvi cases weekly -6.000000
## 140 Lieksa cases weekly -23.000000
## 141 Lieto cases weekly 2.333333
## 142 Liminka cases weekly -5.000000
## 144 Lohja cases weekly -19.000000
## 145 Loimaa cases weekly -14.000000
## 146 Loppi cases weekly -11.000000
## 147 Loviisa cases weekly 2.428571
## 151 Luoto cases weekly -22.000000
## 153 Maalahti cases weekly -8.000000
## 154 Maarianhamina cases weekly 2.600000
## 156 Masku cases weekly -15.000000
## 160 Mikkeli cases weekly -69.000000
## 161 Muhos cases weekly -5.000000
## 164 Mustasaari cases weekly 3.538462
## 165 Muurame cases weekly -7.000000
## 166 Mynämäki cases weekly -5.000000
## 168 Mäntsälä cases weekly 1.666667
## 169 Mänttä-Vilppula cases weekly -10.000000
## 171 Naantali cases weekly 2.250000
## 173 Nivala cases weekly -7.000000
## 174 Nokia cases weekly -14.000000
## 177 Nurmijärvi cases weekly 1.190476
## 178 Närpiö cases weekly 3.166667
## 179 Orimattila cases weekly -9.000000
## 183 Oulu cases weekly 2.764045
## 186 Paimio cases weekly 29.000000
## 188 Parainen cases weekly -13.000000
## 190 Parkano cases weekly -21.000000
## 191 Pedersören kunta cases weekly 2.166667
## 196 Petäjävesi cases weekly -6.000000
## 197 Pieksämäki cases weekly 1.439024
## 199 Pietarsaari cases weekly -14.000000
## 201 Pirkkala cases weekly -25.000000
## 204 Pori cases weekly 50.000000
## 205 Pornainen cases weekly -5.000000
## 206 Porvoo cases weekly 3.000000
## 210 Punkalaidun cases weekly -6.000000
## 212 Puumala cases weekly -5.000000
## 213 Pyhtää cases weekly -9.000000
## 216 Pyhäntä cases weekly -7.000000
## 217 Pyhäranta cases weekly -5.000000
## 219 Pöytyä cases weekly -6.000000
## 220 Raahe cases weekly 1.200000
## 221 Raasepori cases weekly -9.000000
## 222 Raisio cases weekly 3.125000
## 225 Rauma cases weekly 1.057143
## 226 Rautalampi cases weekly 2.333333
## 229 Reisjärvi cases weekly -5.000000
## 230 Riihimäki cases weekly -16.000000
## 232 Rovaniemi cases weekly -25.000000
## 235 Rusko cases weekly -6.000000
## 239 Salo cases weekly 2.625000
## 241 Sastamala cases weekly -7.000000
## 244 Savonlinna cases weekly 1.687500
## 246 Seinäjoki cases weekly 4.600000
## 247 Sievi cases weekly -7.000000
## 251 Siilinjärvi cases weekly -17.000000
## 253 Sipoo cases weekly 3.000000
## 254 Siuntio cases weekly -6.000000
## 255 Sodankylä cases weekly -31.000000
## 256 Soini cases weekly -6.000000
## 257 Somero cases weekly -8.000000
## 259 Sotkamo cases weekly -9.000000
## 264 Suonenjoki cases weekly -6.000000
## 271 Tampere cases weekly 7.764706
## 278 Tornio cases weekly 3.300000
## 279 Turku cases weekly 2.006452
## 281 Tuusula cases weekly 39.000000
## 282 Tyrnävä cases weekly -8.000000
## 287 Uurainen cases weekly -7.000000
## 288 Uusikaarlepyy cases weekly -12.000000
## 289 Uusikaupunki cases weekly 1.875000
## 291 Vaasa cases weekly 27.230769
## 292 Valkeakoski cases weekly -22.000000
## 293 Vantaa cases weekly 373.000000
## 294 Varkaus cases weekly -10.000000
## 299 Vieremä cases weekly -6.000000
## 300 Vihti cases weekly 1.571429
## 302 Vimpeli cases weekly -9.000000
## 304 Virrat cases weekly -11.000000
## 306 Vöyri cases weekly -14.000000
## 307 Ylitornio cases weekly -12.000000
## 308 Ylivieska cases weekly -17.000000
## 309 Ylöjärvi cases weekly -11.000000
## 312 Äänekoski cases weekly 4.200000muni <- dat[dat$measure=="cases" & dat$period!="daily" & dat$age=="Kaikki ikäryhmät" & dat$sex=="Kaikki sukupuolet",
!colnames(dat) %in% c("age","sex","measure")]
muni$daily <- muni$value / 7
tmp2 <- muni[muni$period=="cumulative",] # tmp[tmp$date=="2021-02-15",] # Start time of daily follow-up
tmp2$old <- tmp2$value
tmp2$time <- tmp2$time + 24*3600
tmp2 <- tmp2[colnames(tmp2) %in% c("place","time","old")]
muni <- merge(muni, tmp2, all.x=TRUE)
muni$daily <- ifelse(muni$period=="cumulative", muni$value - muni$old, muni$daily)
muni <- muni[!is.na(muni$daily) & muni$time < Sys.time() , ]
muni <- muni[order(muni$time),]
week <- numeric()
for(i in 1:nrow(muni)) {
ts <- muni[muni$place==muni$place[i] , c("time","daily")]
week <- c(week, mean(ts$daily[ts$time <= muni$time[i] & ts$time > muni$time[i]- 7*24*3600],na.rm = TRUE))
}
muni$week <- week
plot_ly(data = muni, x = ~time, y=~daily, fillcolor=~place, type="scatter", mode="lines") %>%
layout(title="Daily cases of covid-19 by place")plot_ly(data = muni[muni$place %in% cities,], x = ~time, y=~daily, fillcolor=~place, type="scatter", mode="lines") %>%
layout(title="Daily cases of covid-19 by place")plot_ly(data = muni[muni$place %in% shp , ], x = ~time, y=~daily, fillcolor=~place, type="scatter", mode="lines") %>%
layout(title="Daily cases of covid-19 by place")plot_ly(data = muni[muni$place %in% cities , ], x = ~time, y=~week, fillcolor=~place, type="scatter", mode="lines") %>%
layout(title="Weekly average cases of covid-19 by place")#################### VACCINATION
vac <- read.csv("http://77.86.191.32/rtools_server/runs/covid_vaccination_daily_fi.csv") #daily updates
for(i in c(1,2,5)) {
vac[[i]] <- as.factor(vac[[i]])
}
vac$time <- as.POSIXct(vac$time)
vac$SHP <- grepl("(SHP|Ahvenanmaa)",vac$place)
days <- length(unique(vac$time))
vac <- vac[vac$SHP & vac$age!="Kaikki iät",]
vac <- vac[!(vac$time=="2021-03-01" & vac$measure=="second shot"),] # There seems to be double counting in data
tmp <- aggregate(vac$value, by = vac[c("place","time","measure")], FUN=function(x) sum(x, na.rm=TRUE))
plot_ly(tmp, x = ~time, y = ~x, color = ~place, linetype = ~measure, type="scatter", mode="lines") %>%
layout(title="Rokotuskattavuus")## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colorstmp <- aggregate(vac$value, by = vac[c("age","time","measure")], FUN=function(x) sum(x, na.rm=TRUE))
plot_ly(tmp, x = ~time, y = ~x, color = ~age, linetype = ~measure, type="scatter", mode="lines") %>%
layout(title="Rokotuskattavuus")## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors
## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colorstmp <- aggregate(vac$value, by = vac[c("time","measure")], FUN=function(x) sum(x, na.rm=TRUE))
plot_ly(tmp, x = ~time, y = ~x, color = ~measure, type="scatter", mode="lines") %>%
layout(title="Rokotuskattavuus")## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levelstmp <- aggregate(vac$value, by = vac[c("age","measure")], FUN=function(x) sum(x, na.rm=TRUE))
tmp$x <- tmp$x / days
plot_ly(tmp, x = ~age, y = ~x, color = ~measure, type="scatter", mode="lines") %>%
layout(title="Rokotuskattavuus")## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levels
## Warning in RColorBrewer::brewer.pal(N, "Set2"): minimal value for n is 3, returning requested palette with 3 different levelsConclusions
- Most municipalities are able to reduce the number of cases by more than a half in two weeks.
- Important exceptions are Helsinki, Vantaa, Espoo, Rauma, and several small municipalities in Uusimaa.
- After a long, slow worsening, the situation in Uusimaa is quickly starting to get bad since 2021-02-15.
#tsd <- dat[dat$measure=="cases" & !grepl("SHP",dat$place) & dat$period=="weekly",]
tsd <- dat[dat$measure=="cases" & dat$place!="Kaikki Alueet" & dat$period=="cumulative" , ]
tsd$date <- as.Date(tsd$time)
tsd <- tsd[order(tsd$date),]
tsd <- reshape(tsd[c("place","date","value")], v.names = "value", timevar = "place",idvar = "date",
direction="wide")
colnames(tsd) <- gsub("value\\.","",colnames(tsd))
tsd <- tsd[c("date",sort(colnames(tsd)[2:ncol(tsd)]))]
trend <- data.frame(date = tsd$date)
trend. <- trend[2:nrow(trend),1,drop=FALSE]
for(i in 2:ncol(tsd)) {
tsd[[i]] <- ts(tsd[[i]], start=7, frequency = 7)
trend[[colnames(tsd[i])]] <- decompose(tsd[[i]])$trend
trend.[[colnames(tsd[i])]] <- ts(tsd[2:nrow(tsd),i] - tsd[1:(nrow(tsd)-1),i], start=7, frequency=7)
if(colnames(tsd)[i] %in% cities) plot(decompose(trend.[[i]]),xlab=colnames(tsd)[i])
}
plot_ly(data=melt(trend.,id.vars = "date",value.name="value", variable.name = "Area"),
x=~date, y=~value, color=~Area, type="scatter",mode="lines")## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors
## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors#######################
shp <- dat[dat$measure=="cases" & grepl("SHP",dat$place) & dat$period=="daily" , ]
shp$date <- as.Date(shp$time)
shp <- shp[order(shp$date),]
shp <- reshape(shp[c("place","date","value")], v.names = "value", timevar = "place",idvar = "date",
direction="wide")
shp <- shp[shp$date >= "2020-01-28" & shp$date <= "2021-02-14" , ] # no values beyond this period
colnames(shp) <- gsub("value\\.","",colnames(shp))
shp <- shp[c("date",sort(colnames(shp)[2:ncol(shp)]))]
trends <- data.frame(date = shp$date)
for(i in 2:ncol(shp)) {
shp[[i]] <- ts(shp[[i]], start=1, frequency = 7)
plot(decompose(shp[[i]]),xlab=colnames(shp)[i])
trends[[colnames(shp[i])]] <- decompose(shp[[i]])$trend
}
plot_ly(data=melt(trends,id.vars = "date",value.name="value", variable.name = "Area"),
x=~date, y=~value, color=~Area, type="scatter",mode="lines")## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors
## Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
## Returning the palette you asked for with that many colors